package ReadPrefetch;
#---------------------------------------------------------------------
# ReadPrefetch.pm
# Perl module to read Prefetch files in binary format
#
# Changes:
#   20091209: Added code to handle the non support of Vista (and Windows 7) Prefetch
#   20091106: created
#
# copyright 2009 J-F. Gingras, jean.francois.gingras@gmail.com
#---------------------------------------------------------------------
use strict;
use Exporter;
use Carp;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

$VERSION     = 0.2;
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw(new);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration  use ReadPrefetch ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.

# Global variables
my $self;        # self reference
my $MAGIC = 0x41434353;
my %version = (0x00000011 => "PREFETCH_XP",
               0x00000017 => "PREFETCH_VISTA");

#---------------------------------------------------------------------
# new()
# opens file in binary mode; blesses self, including file handle
#---------------------------------------------------------------------            
sub new {
  $self = {};
  $self->{file} = shift;
  $self->{curr_ofs} = 0;
  if (open($self->{hFile},"<",$self->{file})) {
    binmode($self->{hFile});
    return bless($self);
  }
  else {
    carp "Could not open ".$self->{file}." : ".$!."\n";
    return undef;
  }
}

#---------------------------------------------------------------------
# getFirstVIBOffset();
# gets the offset to the first Volume Information Block in the file;
# populates $self->{first_ofs} and $self->{curr_ofs} with the value of
# the current offset
# Output: Offset of the beginning of the first Volume Information Block
#---------------------------------------------------------------------
sub getFirstVIBOffset {
  $self = shift;
  
  my %hdr = %{ $self->{header} }; # I think this will be threated as a
                                  # reference beceause Perl complains if
                                  # I try to force a reference with \%
                                  # and then deference it with %{hdr}
  
  if (1 != $self->{validheader}) {
    $self->{error} = "Header not valid";
    carp $self->{error};
  }
  
  seek($self->{hFile},$hdr{vib_off},0);
  $self->{curr_ofs} = $hdr{vib_off};
  
  return $self->{curr_ofs};
}

#---------------------------------------------------------------------
# getNextVIBOffset();
# locates the next eVolume Information Block and populates
# $self->{curr_ofs} with the value of the current offset
# Input : Length of previous Volume Information Block
# Output: Offset of the beginning of the next Volume Information Block
#---------------------------------------------------------------------
sub getNextVIBOffset {
  $self = shift;
  
  my %hdr = %{ $self->{header} }; # I think this will be threated as a
                                  # reference beceause Perl complains if
                                  # I try to force a reference with \%
                                  # and then deference it with %{hdr}
  
  if (1 != $self->{validheader}) {
    $self->{error} = "Header not valid";
    carp $self->{error};
  }
  
  seek($self->{hFile},$self->{curr_ofs} + 0x28,0);
  $self->{curr_ofs} += 0x28;
  
  return $self->{curr_ofs};
}

#---------------------------------------------------------------------
# parseHeader()
# Parses header information from a .pf file; return a hash
# If the magic number is not found in the proper location or the
# signature does not match known signatures, the header is deemed
# invalid
#---------------------------------------------------------------------
sub parseHeader {
  $self = shift;
  my %hdr = ();
  my $hsize=48; # 48 on XP; 56 on Vista
  seek($self->{hFile},0x00,0);
  eval {
     my $bytes = read($self->{hFile},$self->{record},100);
     if (100 == $bytes) {
      ($hdr{signature},$hdr{magic},$hdr{pfsize})
        = unpack("VVx4v",$self->{record});
      ##
      # this is so ugly...
      #
      # extract filename (we look for null terminated string)
      $self->{record} = substr($self->{record},16);
      $bytes = index($self->{record},"\0\0",0);
      if ($bytes >= 0) {
        $hdr{fname} = _uniToAscii(substr($self->{record},0,$bytes));
      }
    }  
  };
  if ($@) {
    undef %hdr;
    $self->{error} = $@;
  }
  else {
    if ($hdr{magic} != $MAGIC) {
      undef %hdr;
      $self->{error} = "Magic number not valid";
    }
    else {
      if (! exists $version{$hdr{signature}}) {
        undef %hdr;
        $self->{error} = "Signature not valid";
      } elsif ($version{$hdr{signature}} eq 'PREFETCH_VISTA') {
          undef %hdr;
          $selft->{error} = "Vista prefetch not yet supported";
      }
      if (%hdr) {
        seek($self->{hFile},0x64,0);
        eval {
          $hsize = 56 if ($version{$hdr{signature}} eq 'PREFETCH_VISTA');
          my @val;
          my $bytes = read($self->{hFile},$self->{record},$hsize);
          if ($hsize == $bytes) {
            if ($version{$hdr{signature}} eq 'PREFETCH_XP') {
              ($hdr{fpb_off},$hdr{fpb_len},$hdr{vib_off},$hdr{vib_cnt},$hdr{vib_len},$hdr{runtime_lo},$hdr{runtime_hi},$hdr{runcount})
                = unpack("VVVVVVVx16V",$self->{record});
            } else {
              ($hdr{fpb_off},$hdr{fpb_len},$hdr{vib_off},$hdr{vib_cnt},$hdr{vib_len},$hdr{runtime_lo},$hdr{runtime_hi},$hdr{runcount})
                = unpack("VVVVVVx8Vx16V",$self->{record});
            }
            $self->{validheader} = 1;
            %{ $self->{header} } = %hdr; # do a top-level copy of the hash
          }
        };
      }
    }
  }
  return %hdr;
}

#---------------------------------------------------------------------
# parseFilePathsBlock()
# 
#---------------------------------------------------------------------
sub parseFilePathsBlock {
  $self = shift;
  my %fpb = ();
  
  my %hdr = %{ $self->{header} }; # I think this will be threated as a
                                  # reference beceause Perl complains if
                                  # I try to force a reference with \%
                                  # and then deference it with %{hdr}
  
  if (1 != $self->{validheader}) {
    $self->{error} = "Header not valid";
    carp $self->{error};
  }
  
  my $bytes;
  
  seek($self->{hFile},$hdr{fpb_off},0);
  eval {
    $bytes = read($self->{hFile},$self->{record},$hdr{fpb_len});
  };
  if ($@) {
    $self->{error} = $@;
    carp $self->{error};
  }
  
  if ($bytes < $hdr{fpb_len}) {
    $self->{error} = "Total number of bytes read = $bytes";
    undef %hdr;
  }
  else {
    my $p_idx = 0;
    my $n_idx = -1;
    my $cnt = 0;
    while(1) {
      # we look for null terminated string
      $n_idx = index($self->{record},"\0\0\0",$p_idx);
      
      $cnt++;
      
      # get the string len
      my $len = $n_idx - $p_idx;
      
      # extract filepath
      if ($p_idx >= 0 && $len > 0) {
        $fpb{$cnt} = _uniToAscii(substr($self->{record},$p_idx,$len));
      }
      
      # can't find null terminated string ?
      if ($n_idx == -1) {
        last; # quit the inner loop
      }
      
      $n_idx += 3;     # skip the null caracter
      $p_idx = $n_idx; # backup the the new offset
    }
  }
  %{ $self->{FPB} } = %fpb; # do a top-level copy of the hash
  
  return %fpb;
}

#---------------------------------------------------------------------
# parseVolumeInformationBlock()
# 
#---------------------------------------------------------------------
sub parseVolumeInformationBlock {
  $self = shift;
  my %vib = ();
  
  my %hdr = %{ $self->{header} }; # I think this will be threated as a
                                  # reference beceause Perl complains if
                                  # I try to force a reference with \%
                                  # and then deference it with %{$hdr}
  
  if (1 != $self->{validheader}) {
    $self->{error} = "Header not valid";
    carp $self->{error};
  }
  
  my $vcnt = 0; # holds the number of VIB processed
  
  # position ourself on the first VIB
  $self->getFirstVIBOffset();
  while($vcnt < $hdr{vib_cnt}) {
    my $bytes;
    
    # increase count
    $vcnt++;
    $vib{$vcnt} = ();
  
    eval {
      $bytes = read($self->{hFile},$self->{record},0x28);
    };
    if ($@) {
      $self->{error} = $@;
      carp $self->{error};
    }
    
    if ($bytes < 0x28) {
      $self->{error} = "Total number of bytes read = $bytes";
      undef %vib;
      last; # quit main loop
    }
    else {
      # Read Volume Information Header
      ($vib{$vcnt}{path_off},$vib{$vcnt}{path_len},$vib{$vcnt}{ctime_lo},
       $vib{$vcnt}{ctime_hi},$vib{$vcnt}{sn},$vib{$vcnt}{blob_off},
       $vib{$vcnt}{blob_len},$vib{$vcnt}{folder_off},
       $vib{$vcnt}{folder_cnt},undef)
       = unpack("VVVVVVVVVV",$self->{record});
      #print "key : ".$_." value : ".$vib{$vcnt}{$_}."\n" foreach(sort keys %{ $vib{$vcnt} });
      
      # Read Volume Path
      seek($self->{hFile},$hdr{vib_off}+$vib{$vcnt}{path_off},0);
      eval {
        $bytes = read($self->{hFile},$self->{record},($vib{$vcnt}{path_len} * 2));
      };
      if ($@) {
        $self->{error} = $@;
        carp $self->{error};
      }
      if ($bytes / 2 < $vib{$vcnt}{path_len}) {
        $self->{error} = "Can't read volume path";
        undef %vib;
        last; # quit main loop
      }
      else {
        $vib{$vcnt}{path} = _uniToAscii($self->{record});
        
        # More variables to be used
        $vib{$vcnt}{fpb} = ();
        my $p_idx = 0;
        my $n_idx = -1;
        my $len = 0;
        
        # position ourself on the Volume folder paths block
        seek($self->{hFile},$hdr{vib_off}+$vib{$vcnt}{folder_off},0);
        
        # Fill the buffer with the whole VIB length (even thought we don't
        # need all the data for the current Volume
        eval {
        $bytes = read($self->{hFile},$self->{record},$hdr{vib_len});
        };
        if ($@) {
          $self->{error} = $@;
          carp $self->{error};
        }
        
        if (! defined $bytes || $bytes <= 0) {
          last; # quit the main loop
        }
        
        my $fcnt = 0;
        #print "fcnt: ".$fcnt." folder_cnt : ".$vib{$vcnt}{folder_cnt}."\n";
        while($fcnt < $vib{$vcnt}{folder_cnt}) {
          # we look for null terminated string
          $n_idx = index($self->{record},"\0\0\0",$p_idx);
          
          # increase count
          $fcnt++;
          
          # get the string len
          ($len) = unpack("v",substr($self->{record},$p_idx,2));
          
          # extract filepath
          if ($p_idx >= 0 && defined $len && $len > 0) {
            $p_idx += 2; # skip the strlen value
            $len *= 2;   # unicode is two bytes wide
            # add the filepath to the current Volume FPB hash
            $vib{$vcnt}{fpb}{$fcnt} = _uniToAscii(substr($self->{record},$p_idx,$len));
          }
          
          # can't find null terminated string ?
          if ($n_idx == -1) {
            last; # quit the inner loop
          }
          
          $n_idx += 3;     # skip the null caracter
          $p_idx = $n_idx; # backup the the new offset
        }
      }
    }
    if ($self->getNextVIBOffset() == -1) {
      last; # quit main loop
    }
  }

  %{ $self->{VIB} } = %vib; # do a top-level copy of the hash
  
  return %vib;
}

#---------------------------------------------------------------------
# close()
# close the filehandle
#---------------------------------------------------------------------
sub close {close($self->{hFile});}

#----------------------------------------------------------------
# _uniToAscii()
# Input : Unicode string
# Output: ASCII string
# Removes every other \00 from Unicode strings, returns ASCII string
# Author: H. Carvey, keydet89@yahoo.com
#----------------------------------------------------------------
sub _uniToAscii {
  my $str = $_[0];
  my $len = length($str);
  my $newlen = $len - 1;
  my @str2;
  my @str1 = split(//,$str,$len);
  foreach my $i (0..($len - 1)) {
    if ($i % 2) {
# In a Unicode string, the odd-numbered elements of the list will be \00
# so just drop them      
    }
    else {
      push(@str2,$str1[$i]);
    }
  }
  return join('',@str2);
}

#----------------------------------------------------------------
# getError()
# returns the error message for the module
#----------------------------------------------------------------
sub getError {return $self->{error};}

1;
__END__

=head1 NAME

File::ReadPrefetch - Perl module to read/parse Windows Prefetch files

=head1 SYNOPSIS

see example files

=head1 DESCRIPTION

File::ReadPrefetch is a Perl module that can be used to parse/read an MS Windows
Prefetch file.

=head1 SEE ALSO

PrefetchFile Structure
  http://42llc.net/index.php?option=com_myblog&show=Prefetch-Files-Revisited.html&Itemid=39

PrefetchFile Hash Algorithm
  http://42llc.net/index.php?option=com_myblog&show=Prefetch-Hash-Algorithm.html&Itemid=39

Forensics Wiki
 http://www.forensicswiki.org/wiki/Prefetch

=head1 AUTHOR

Jean-Francois Gingras, E<lt>jean.francois.gingras@gmail.com<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by Jean-Francois Gingras (jean.francois.gingras@gmail.com)

This library is free software; you can redistribute it and/or modify
it as you like.  However, please be sure to provide proper credit where
it is due.

=cut
